home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d923.lha
/
MagicClip
/
MagicClip.mod
< prev
next >
Wrap
Text File
|
1993-10-07
|
7KB
|
198 lines
(* --------------------------------------------------------------------------
:Program. MagicClip.mod
:Contents. Shell interface for Clipboard text
:Author. Franz Schwarz
:Copyright. Freeware (freely distributable, copyrighted software)
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:History. v1.0 19-Jul-93 fSchwarz
:History. v1.1 5-Aug-93 fSchwarz - workaround for V37 Dos.Flush()
:History. enforcer hit (fixed in V39 Dos) when wbStarted, fixed
:History. OpenIFF()/CloseIFF() ressource freeing bug
:History. v1.2 5-Aug-93 fSchwarz - fixed magic newline insertion
:History. added environment variable support for ID text that
:History. separates 2 chunks & for ID text at the end of all text
:History. added CTRL_C break checking
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Remark. Amiga-Oberon 3.00 checks string pointers to be even if
:Remark. OddChk is enabled: thus don't compile with OddChk.
:Usage. "UNIT/K/N,GET/S,FILE/K,PUT/F"
-------------------------------------------------------------------------- *)
MODULE MagicClip;
IMPORT
st: Strings, e: Exec, d: Dos, I: Intuition, iff: IFFParse,
o: OberonLib, y: SYSTEM;
CONST
verTag = "\000$VER: MagicClip 1.2 (5.8.93) © Franz.Schwarz@mil.ka.sub.org - Freeware";
templ = "UNIT/K/N,GET/S,FILE/K,PUT/F";
varSize = 256;
chunkSepName = "MAGICCLIPCHUNKSEP";
endTxtName = "MAGICCLIPENDTXT";
TYPE
LStrPtr = UNTRACED POINTER TO ARRAY MAX (LONGINT)-1 OF CHAR;
LongIntStruct = STRUCT
l: LONGINT;
END;
CONST
bufSize = 256;
unit0 = LongIntStruct (0);
idFTXT = y.VAL (LONGINT, 'FTXT');
idCHRS = y.VAL (LONGINT, 'CHRS');
wroteThisChunk = 0;
wroteLastChunk = 1;
TYPE
ArgsT = STRUCT
unit: UNTRACED POINTER TO LONGINT;
get : LONGINT;
file: LStrPtr;
put : LStrPtr;
END;
VAR
iffh : iff.IFFHandlePtr;
cn : iff.ContextNodePtr;
fh : d.FileHandlePtr;
rda : d.RDArgsPtr;
args : ArgsT;
c : LONGINT;
tcnk : BOOLEAN;
wrte : SET;
buf : ARRAY bufSize OF CHAR;
chunksep: ARRAY varSize OF CHAR;
endtxt : ARRAY varSize OF CHAR;
iffopn : BOOLEAN;
chseplen: LONGINT;
endtxlen: LONGINT;
PROCEDURE Halt (ret: LONGINT);
BEGIN
o.Result := ret;
o.HaltProc ();
END Halt;
BEGIN
IF o.wbStarted THEN I.DisplayBeep (NIL); Halt (d.fail); END;
IF d.dos.lib.version < 37 THEN
y.SETREG (0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
Halt (d.fail);
END;
IF iff.base = NIL THEN d.PrintF ("Need iffparse.library!\n"); Halt (d.fail); END;
rda := d.ReadArgs (templ, args, NIL);
IF rda = NIL THEN Halt (d.fail); END;
IF args.unit = NIL THEN args.unit := y.ADR (unit0); END;
IF (args.unit^ < 0) OR (args.unit^ > 255) THEN
y.SETREG (0, d.SetIoErr (d.badNumber)); Halt (d.fail);
END;
c := 0; IF args.get # 0 THEN INC (c); END;
IF args.file # NIL THEN INC (c); END; IF args.put # NIL THEN INC (c); END;
IF c > 1 THEN y.SETREG (0, d.SetIoErr (d.tooManyArgs)); Halt (d.fail); END;
IF c < 1 THEN y.SETREG (0, d.SetIoErr (d.requiredArgMissing)); Halt (d.fail); END;
iffh := iff.AllocIFF ();
IF iffh = NIL THEN Halt (d.fail); END;
iffh.stream := y.VAL (LONGINT, iff.OpenClipboard (args.unit^));
IF iffh.stream = NIL THEN Halt (d.fail); END;
iff.InitIFFasClip (iffh);
IF args.get # 0 THEN
chseplen := d.GetVar (chunkSepName, chunksep, LEN (chunksep), LONGSET{d.binaryVar});
IF chseplen < 0 THEN COPY ("\n", chunksep); chseplen := 1; END;
endtxlen := d.GetVar (endTxtName, endtxt, LEN (endtxt), LONGSET{d.binaryVar});
IF endtxlen < 0 THEN endtxlen := 0; END;
iffopn := iff.OpenIFF (iffh, iff.read) = 0;
IF ~iffopn THEN Halt (d.fail); END;
IF iff.StopChunk (iffh, idFTXT, idCHRS) # 0 THEN Halt (d.fail); END;
LOOP
CASE iff.ParseIFF (iffh, iff.iffParseScan) OF
iff.IFFErrEOC: |
iff.IFFErrEOF, iff.IFFErrNotIFF:
IF tcnk THEN Halt (d.ok); ELSE Halt (d.warn); END; |
0:
cn := iff.CurrentChunk (iffh);
IF cn # NIL THEN IF cn.type = idFTXT THEN IF cn.id = idCHRS THEN
tcnk := TRUE;
REPEAT
IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN
y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
END;
c := iff.ReadChunkBytes (iffh, buf, LEN (buf));
IF c < 0 THEN Halt (d.fail); END;
IF c > 0 THEN
IF (wroteLastChunk IN wrte) & (chseplen > 0) THEN
IF d.FWrite (d.Output (), chunksep, 1, chseplen) # chseplen THEN Halt (d.fail); END;
END;
wrte := {wroteThisChunk};
IF d.FWrite (d.Output (), buf, 1, c) # c THEN Halt (d.fail); END;
END;
UNTIL c < LEN (buf);
IF wroteThisChunk IN wrte THEN wrte := {wroteLastChunk}; END;
END; END; END; (* IF *)
ELSE
Halt (d.fail);
END;
END;
ELSE
IF args.file # NIL THEN
fh := d.Open (args.file^, d.oldFile);
IF fh = NIL THEN Halt (d.fail); END;
END;
iffopn := iff.OpenIFF (iffh, iff.write) = 0;
IF ~iffopn THEN Halt (d.fail); END;
IF iff.PushChunk (iffh, idFTXT, iff.idFORM, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
IF iff.PushChunk (iffh, 0, idCHRS, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
IF fh = NIL THEN
IF iff.WriteChunkBytes (iffh, args.put^, st.Length (args.put^)) < 0 THEN Halt (d.fail); END;
ELSE
LOOP
IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN
y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
END;
y.SETREG (0, d.SetIoErr (0));
c := d.FRead (fh, buf, 1, LEN (buf));
IF c > 0 THEN
IF iff.WriteChunkBytes (iffh, buf, c) < 0 THEN Halt (d.fail); END;
ELSE
IF d.IoErr () = 0 THEN EXIT; ELSE Halt (d.fail); END;
END;
END; (* LOOP *)
END; (* IF fh = NIL *)
IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
Halt (d.ok);
END;
Halt (-1); (* we should never reach this point! *)
CLOSE
IF fh # NIL THEN d.OldClose (fh); END;
IF iffh # NIL THEN
IF iffopn THEN iff.CloseIFF (iffh); END;
IF iffh.stream # 0 THEN iff.CloseClipboard (y.VAL (e.APTR, iffh.stream)); END;
iff.FreeIFF (iffh);
END;
IF rda # NIL THEN d.FreeArgs (rda); END;
IF d.dos.lib.version >= 37 THEN
IF o.Result > d.warn THEN
IF wrte # {} THEN d.PrintF ("\n"); END;
d.PrintF ("%s failed!\n", y.ADR (verTag[7]));
ELSE
IF (wrte # {}) & (endtxlen > 0) THEN
IF d.FWrite (d.Output (), endtxt, 1, endtxlen) = 0 THEN END;
END;
d.Flush (d.Output ());
END;
END;
END MagicClip.